﻿unit WinSocket;

interface

uses
  Winapi.Windows, WinSock2Ex, System.SysUtils;

{ WinSock 2 extensions -- data types for the condition function in }
{ WSAAccept() and overlapped I/O completion routine. }
type
  LPCONDITIONPROC = function (lpCallerId: LPWSABUF; lpCallerData : LPWSABUF; lpSQOS,lpGQOS : LPQOS; lpCalleeId,lpCalleeData : LPWSABUF;
    g : GROUP; dwCallbackData : DWORD ) : Integer; stdcall;
  LPWSAOVERLAPPED_COMPLETION_ROUTINE = procedure ( const dwError, cbTransferred : DWORD; const lpOverlapped : LPWSAOVERLAPPED; const dwFlags : DWORD ); stdcall;

  {$EXTERNALSYM PTransmitFileBuffers}
  PTransmitFileBuffers = ^TTransmitFileBuffers;
  {$EXTERNALSYM _TRANSMIT_FILE_BUFFERS}
  _TRANSMIT_FILE_BUFFERS = record
      Head: Pointer;
      HeadLength: DWORD;
      Tail: Pointer;
      TailLength: DWORD;
  end;
  {$EXTERNALSYM TTransmitFileBuffers}
  TTransmitFileBuffers = _TRANSMIT_FILE_BUFFERS;
  {$EXTERNALSYM TRANSMIT_FILE_BUFFERS}
  TRANSMIT_FILE_BUFFERS = _TRANSMIT_FILE_BUFFERS;

  LPFN_AcceptEX = function ( sListenSocket: TSocket;
                             AcceptSocket: TSocket;
                             lpOutputBuffer: Pointer;
                             dwReceiveDataLength: DWORD;
                             dwLocalAddressLength: DWORD;
                             dwRemoteAddressLength: DWORD;
                             lpdwBytesReceived: DWORD;
                             lpOverlapped: POverlapped ): BOOL; stdcall;

  LPFN_GetAcceptExSocketaddr = procedure ( lpOutputBuffer: Pointer;
                                           dwReceiveDataLength: DWORD;
                                           dwLocalAddressLength: DWORD;
                                           dwRemoteAddressLength: DWORD;
                                           var LocalSockaddr: PSockAddr;
                                           var LocalSockaddrLength: Integer;
                                           var RemoteSockaddr: PSockAddr;
                                           var RemoteSockaddrLength: Integer ); stdcall;

  LPFN_TransmitFile = function( Socket: TSocket;
                                hFile: THandle;
                                NumberOfBytesToWrite: DWORD;
                                NumberOfBytesPerSend: DWORD;
                                pOvp: POverlapped;
                                pTransmitBuffers: PTransmitFileBuffers;
                                dwFlags: DWORD ): BOOL; stdcall;

  LPFN_DisconnectEx = function( Socket: TSocket;
                                pOvp: POverlapped;
                                Flags: DWORD;
                                Reserved: DWORD ): BOOL; stdcall;


// Constants and structures defined by the internet system,
// Per RFC 790, September 1981, taken from the BSD file netinet/in.h.
const

// Protocols
  IPPROTO_IP     =   0;             // dummy for IP
  IPPROTO_ICMP   =   1;             // control message protocol
  IPPROTO_IGMP   =   2;             // group management protocol
  IPPROTO_GGP    =   3;             // gateway^2 (deprecated)
  IPPROTO_TCP    =   6;             // TCP
  IPPROTO_PUP    =  12;             // pup
  IPPROTO_UDP    =  17;             // UDP - user datagram protocol
  IPPROTO_IDP    =  22;             // xns idp
  IPPROTO_ND     =  77;             // UNOFFICIAL net disk proto

  IPPROTO_RAW    = 255;             // raw IP packet
  IPPROTO_MAX    = 256;

// Port/socket numbers: network standard functions
  IPPORT_ECHO        =   7;
  IPPORT_DISCARD     =   9;
  IPPORT_SYSTAT      =  11;
  IPPORT_DAYTIME     =  13;
  IPPORT_NETSTAT     =  15;
  IPPORT_FTP         =  21;
  IPPORT_TELNET      =  23;
  IPPORT_SMTP        =  25;
  IPPORT_TIMESERVER  =  37;
  IPPORT_NAMESERVER  =  42;
  IPPORT_WHOIS       =  43;
  IPPORT_MTP         =  57;

// Port/socket numbers: host specific functions
  IPPORT_TFTP        =  69;
  IPPORT_RJE         =  77;
  IPPORT_FINGER      =  79;
  IPPORT_TTYLINK     =  87;
  IPPORT_SUPDUP      =  95;

// UNIX TCP sockets
  IPPORT_EXECSERVER  = 512;
  IPPORT_LOGINSERVER = 513;
  IPPORT_CMDSERVER   = 514;
  IPPORT_EFSSERVER   = 520;

// UNIX UDP sockets
  IPPORT_BIFFUDP     = 512;
  IPPORT_WHOSERVER   = 513;
  IPPORT_ROUTESERVER = 520;

// Ports < IPPORT_RESERVED are reserved for  privileged processes (e.g. root).
  IPPORT_RESERVED    =1024;

// Link numbers
  IMPLINK_IP         = 155;
  IMPLINK_LOWEXPER   = 156;
  IMPLINK_HIGHEXPER  = 158;

  TF_DISCONNECT      = $01;
  TF_REUSE_SOCKET    = $02;
  TF_WRITE_BEHIND    = $04;

// This is used instead of -1, since the TSocket type is unsigned.
  INVALID_SOCKET     = TSocket(not(0));
  SOCKET_ERROR       = -1;

//  The  following  may  be used in place of the address family, socket type, or
//  protocol  in  a  call  to WSASocket to indicate that the corresponding value
//  should  be taken from the supplied WSAPROTOCOL_INFO structure instead of the
//  parameter itself.
  FROM_PROTOCOL_INFO = -1;


// Types
  SOCK_STREAM     = 1;               { stream socket }
  SOCK_DGRAM      = 2;               { datagram socket }
  SOCK_RAW        = 3;               { raw-protocol interface }
  SOCK_RDM        = 4;               { reliably-delivered message }
  SOCK_SEQPACKET  = 5;               { sequenced packet stream }

// Option flags per-socket.
  SO_DEBUG            = $0001;            // turn on debugging info recording
  SO_ACCEPTCONN       = $0002;            // socket has had listen()
  SO_REUSEADDR        = $0004;            // allow local address reuse
  SO_KEEPALIVE        = $0008;            // keep connections alive
  SO_DONTROUTE        = $0010;            // just use interface addresses
  SO_BROADCAST        = $0020;            // permit sending of broadcast msgs
  SO_USELOOPBACK      = $0040;            // bypass hardware when possible
  SO_LINGER           = $0080;            // linger on close if data present
  SO_OOBINLINE        = $0100;            // leave received OOB data in line

  SO_DONTLINGER       = not SO_LINGER;
  SO_EXCLUSIVEADDRUSE = not SO_REUSEADDR; // disallow local address reuse

// Additional options.

  SO_SNDBUF           = $1001;      // send buffer size
  SO_RCVBUF           = $1002;      // receive buffer size
  SO_SNDLOWAT         = $1003;      // send low-water mark
  SO_RCVLOWAT         = $1004;      // receive low-water mark
  SO_SNDTIMEO         = $1005;      // send timeout
  SO_RCVTIMEO         = $1006;      // receive timeout
  SO_ERROR            = $1007;      // get error status and clear
  SO_TYPE             = $1008;      // get socket type

// Options for connect and disconnect data and options.
// Used only by non-TCP/IP transports such as DECNet, OSI TP4, etc.
  SO_CONNDATA         = $7000;
  SO_CONNOPT          = $7001;
  SO_DISCDATA         = $7002;
  SO_DISCOPT          = $7003;
  SO_CONNDATALEN      = $7004;
  SO_CONNOPTLEN       = $7005;
  SO_DISCDATALEN      = $7006;
  SO_DISCOPTLEN       = $7007;

// Option for opening sockets for synchronous access.
  SO_OPENTYPE         = $7008;
  SO_SYNCHRONOUS_ALERT    = $10;
  SO_SYNCHRONOUS_NONALERT = $20;

// Other NT-specific options.
  SO_MAXDG                 = $7009;
  SO_MAXPATHDG             = $700A;
  SO_UPDATE_ACCEPT_CONTEXT = $700B;
  SO_CONNECT_TIME          = $700C;

// TCP options.
  TCP_NODELAY              = $0001;
  TCP_BSDURGENT            = $7000;

// WinSock 2 extension -- new options
  SO_GROUP_ID              = $2001; // ID of a socket group
  SO_GROUP_PRIORITY        = $2002; // the relative priority within a group
  SO_MAX_MSG_SIZE          = $2003; // maximum message size
  SO_Protocol_InfoA        = $2004; // WSAPROTOCOL_INFOA structure
  SO_Protocol_InfoW        = $2005; // WSAPROTOCOL_INFOW structure
{$IFDEF UNICODE}
  SO_Protocol_Info         = SO_Protocol_InfoW;
{$ELSE}
  SO_Protocol_Info         = SO_Protocol_InfoA;
{$ENDIF}
  PVD_CONFIG               = $3001; // configuration info for service provider
  SO_CONDITIONAL_ACCEPT    = $3002; // enable true conditional accept:
                                    // connection is not ack-ed to the
                                    // other side until conditional
                                    // function returns CF_ACCEPT

// Address families.
  AF_UNSPEC       = 0;               // unspecified
  AF_UNIX         = 1;               // local to host (pipes, portals)
  AF_INET         = 2;               // internetwork: UDP, TCP, etc.
  AF_IMPLINK      = 3;               // arpanet imp addresses
  AF_PUP          = 4;               // pup protocols: e.g. BSP
  AF_CHAOS        = 5;               // mit CHAOS protocols
  AF_IPX          = 6;               // IPX and SPX
  AF_NS           = AF_IPX;          // XEROX NS protocols
  AF_ISO          = 7;               // ISO protocols
  AF_OSI          = AF_ISO;          // OSI is ISO
  AF_ECMA         = 8;               // european computer manufacturers
  AF_DATAKIT      = 9;               // datakit protocols
  AF_CCITT        = 10;              // CCITT protocols, X.25 etc
  AF_SNA          = 11;              // IBM SNA
  AF_DECnet       = 12;              // DECnet
  AF_DLI          = 13;              // Direct data link interface
  AF_LAT          = 14;              // LAT
  AF_HYLINK       = 15;              // NSC Hyperchannel
  AF_APPLETALK    = 16;              // AppleTalk
  AF_NETBIOS      = 17;              // NetBios-style addresses
  AF_VOICEVIEW    = 18;              // VoiceView
  AF_FIREFOX      = 19;              // FireFox
  AF_UNKNOWN1     = 20;              // Somebody is using this!
  AF_BAN          = 21;              // Banyan
  AF_ATM          = 22;              // Native ATM Services
  AF_INET6        = 23;              // Internetwork Version 6
  AF_CLUSTER      = 24;              // Microsoft Wolfpack
  AF_12844        = 25;              // IEEE 1284.4 WG AF
  AF_IRDA         = 26;              // IrDA
  AF_NETDES       = 28;              // Network Designers OSI & gateway enabled protocols

  AF_MAX          = 29;


// Protocol families, same as address families for now.

  PF_UNSPEC       = AF_UNSPEC;
  PF_UNIX         = AF_UNIX;
  PF_INET         = AF_INET;
  PF_IMPLINK      = AF_IMPLINK;
  PF_PUP          = AF_PUP;
  PF_CHAOS        = AF_CHAOS;
  PF_NS           = AF_NS;
  PF_IPX          = AF_IPX;
  PF_ISO          = AF_ISO;
  PF_OSI          = AF_OSI;
  PF_ECMA         = AF_ECMA;
  PF_DATAKIT      = AF_DATAKIT;
  PF_CCITT        = AF_CCITT;
  PF_SNA          = AF_SNA;
  PF_DECnet       = AF_DECnet;
  PF_DLI          = AF_DLI;
  PF_LAT          = AF_LAT;
  PF_HYLINK       = AF_HYLINK;
  PF_APPLETALK    = AF_APPLETALK;
  PF_VOICEVIEW    = AF_VOICEVIEW;
  PF_FIREFOX      = AF_FIREFOX;
  PF_UNKNOWN1     = AF_UNKNOWN1;
  PF_BAN          = AF_BAN;
  PF_ATM          = AF_ATM;
  PF_INET6        = AF_INET6;

  PF_MAX          = AF_MAX;


const
//  Flag bit definitions for dwProviderFlags
  PFL_MULTIPLE_PROTO_ENTRIES   = $00000001;
  PFL_RECOMMENDED_PROTO_ENTRY  = $00000002;
  PFL_HIDDEN                   = $00000004;
  PFL_MATCHES_PROTOCOL_ZERO    = $00000008;

//  Flag bit definitions for dwServiceFlags1
  XP1_CONNECTIONLESS           = $00000001;
  XP1_GUARANTEED_DELIVERY      = $00000002;
  XP1_GUARANTEED_ORDER         = $00000004;
  XP1_MESSAGE_ORIENTED         = $00000008;
  XP1_PSEUDO_STREAM            = $00000010;
  XP1_GRACEFUL_CLOSE           = $00000020;
  XP1_EXPEDITED_DATA           = $00000040;
  XP1_CONNECT_DATA             = $00000080;
  XP1_DISCONNECT_DATA          = $00000100;
  XP1_SUPPORT_BROADCAST        = $00000200;
  XP1_SUPPORT_MULTIPOINT       = $00000400;
  XP1_MULTIPOINT_CONTROL_PLANE = $00000800;
  XP1_MULTIPOINT_DATA_PLANE    = $00001000;
  XP1_QOS_SUPPORTED            = $00002000;
  XP1_INTERRUPT                = $00004000;
  XP1_UNI_SEND                 = $00008000;
  XP1_UNI_RECV                 = $00010000;
  XP1_IFS_HANDLES              = $00020000;
  XP1_PARTIAL_MESSAGE          = $00040000;

  BIGENDIAN    = $0000;
  LITTLEENDIAN = $0001;

  SECURITY_PROTOCOL_NONE = $0000;

//  WinSock 2 extension -- manifest constants for WSAJoinLeaf()
  JL_SENDER_ONLY   = $01;
  JL_RECEIVER_ONLY = $02;
  JL_BOTH          = $04;

//  WinSock 2 extension -- manifest constants for WSASocket()
  WSA_FLAG_OVERLAPPED        = $01;
  WSA_FLAG_MULTIPOINT_C_ROOT = $02;
  WSA_FLAG_MULTIPOINT_C_LEAF = $04;
  WSA_FLAG_MULTIPOINT_D_ROOT = $08;
  WSA_FLAG_MULTIPOINT_D_LEAF = $10;

//  WinSock 2 extension -- manifest constants for WSAIoctl()
  IOC_UNIX      = $00000000;
  IOC_WS2       = $08000000;
  IOC_PROTOCOL  = $10000000;
  IOC_VENDOR    = $18000000;

  SIO_ASSOCIATE_HANDLE                =  1 or IOC_WS2 or IOC_IN;
  SIO_ENABLE_CIRCULAR_QUEUEING        =  2 or IOC_WS2;
  SIO_FIND_ROUTE                      =  3 or IOC_WS2 or IOC_OUT;
  SIO_FLUSH                           =  4 or IOC_WS2;
  SIO_KEEPALIVE_VALS                  =  4 or IOC_IN  or IOC_VENDOR;
  SIO_GET_BROADCAST_ADDRESS           =  5 or IOC_WS2 or IOC_OUT;
  SIO_GET_EXTENSION_FUNCTION_POINTER  =  6 or IOC_WS2 or IOC_INOUT;
  SIO_GET_QOS                         =  7 or IOC_WS2 or IOC_INOUT;
  SIO_GET_GROUP_QOS                   =  8 or IOC_WS2 or IOC_INOUT;
  SIO_MULTIPOINT_LOOPBACK             =  9 or IOC_WS2 or IOC_IN;
  SIO_MULTICAST_SCOPE                 = 10 or IOC_WS2 or IOC_IN;
  SIO_SET_QOS                         = 11 or IOC_WS2 or IOC_IN;
  SIO_SET_GROUP_QOS                   = 12 or IOC_WS2 or IOC_IN;
  SIO_TRANSLATE_HANDLE                = 13 or IOC_WS2 or IOC_INOUT;
  SIO_ROUTING_INTERFACE_QUERY         = 20 or IOC_WS2 or IOC_INOUT;
  SIO_ROUTING_INTERFACE_CHANGE        = 21 or IOC_WS2 or IOC_IN;
  SIO_ADDRESS_LIST_QUERY              = 22 or IOC_WS2 or IOC_OUT; // see below SOCKET_ADDRESS_LIST
  SIO_ADDRESS_LIST_CHANGE             = 23 or IOC_WS2;
  SIO_QUERY_TARGET_PNP_HANDLE         = 24 or IOC_WS2 or IOC_OUT;



//  WinSock 2 extension -- manifest constants for SIO_TRANSLATE_HANDLE ioctl
  TH_NETDEV = $00000001;
  TH_TAPI   = $00000002;




  (* 初始化WinSocket                  *)
  function WSAStartup: Boolean;
  (* 释放WinSocket                    *)
  procedure WSACleanup;
  (* 得到本地IP地址                   *)
  function GetHostIPAddr: PAnsiChar;
  (* 得到远程IP地址                   *)
  function GetRemoteIPAddr(FRemoteAddr: TSockAddrIn): PAnsiChar;
  (* 得到远程端口号                   *)
  function GetRemotePort(FRemoteAddr: TSockAddrIn): WORD;
  (* 关闭Socket套接字                 *)
  function CloseWinSocket(var m_Socket: TSocket): Boolean;
  (* 安全关闭Socket套接字             *)
  function AbortiveCloseSocket(var m_Socket: TSocket): Boolean;
  (* 创建Socket套接字                 *)
  function CreateWSASocket(var m_Socket: TSocket): Boolean;
  (* 创建Socket套接字(TCPOverlap)     *)
  function CreateTCPOverlapSocket(var m_Socket: TSocket): Boolean;
  (* 创建Socket套接字(UDPOverlap)     *)
  function CreateUDPOverlapSocket(var m_Socket: TSocket): Boolean;
  (* 设置UDPSocket大小                *)
  function SetUDPSocketSize(var m_Socket: TSocket; BufSize: DWORD): Boolean;

  (* 设置端口复用                     *)
  function SetSocketReUseAddr(var m_Socket: TSocket): Boolean;
  (* 设置Socket为ListenSocket状态     *)
  function ChangeSocketModeAccept(var m_Socket, m_sListen: TSocket): Boolean;
  (* 设置nagle算法                    *)
  function SetSocketNagle(var m_Socket: TSocket; bVal: Boolean = TRUE): Boolean;
  (* 设置KeepAlive                    *)
  function SetKeepAlive(var m_Socket: TSocket; bVal: Boolean; AKeepAliveTime:Cardinal): Boolean;
  (* 设置Socket接收超时时间           *)
  function SetRecvTimeOut(var m_Socket: TSocket; m_nTimeOut: Integer):Boolean;
  (* 设置Socket发送超时时间           *)
  function SetSendTimeOut(var m_Socket: TSocket; m_nTimeOut: Integer):Boolean;

  (* 加载扩展函数AcceptEx             *)
  function LoadAcceptEx( var m_Socket: TSocket; var m_lpfnAcceptEx: LPFN_AcceptEx ): Boolean;
  (* 加载扩展函数GetAcceptExSockaddrs *)
  function LoadAcceptExSockaddrs( var m_Socket: TSocket;
                                  var m_lpfnGetAcceptExSockaddr: LPFN_GetAcceptExSocketaddr ): Boolean;
  (* 加载扩展函数GetTransmitFile      *)
  function LoadTransmitFile( var m_Socket: TSocket;
                             var m_lpfnTransmitFile: LPFN_TransmitFile ): Boolean;
  (* 加载扩展函数DisconnectEx         *)
  function LoadDisconnectEx( var m_Socket: TSocket;
                             var m_lpfnDisconnectEx: LPFN_DisconnectEx ): Boolean;


  (* 是否绑定套接字                   *)
  function IsBindSocket(m_nPort: Integer): Boolean;
  function BindSocket(var m_Socket: TSocket; m_nPort: Integer): Boolean; overload;
  function BindSocket(var m_Socket: TSocket; const strIPAddr: AnsiString; m_nPort: Integer): Boolean; overload;
  (* 侦听套接字                       *)
  function ListenSocket(var m_Socket: TSocket): Boolean;
  (* 套接字连接建立三次握手           *)
  function Connect(var m_Socket: TSocket; strIPAddr: AnsiString; nPort: DWORD): Boolean;

  (* 修改注册表Socket连接数限制       *)
  procedure WriteSocketConnRegKey;

implementation
  uses Registry;

function CheckRunning2K: Boolean;
var
  ver: Cardinal;
begin
  ver := GetVersion;
  Result := ((ver and $80000000) = 0) and ((ver and $FF) >= 4);
end;

function WSAStartup: Boolean;
var
  m_WSAData: TWSAData;
begin
  Result := FALSE;
  if CheckRunning2K then
    Result := WinSock2Ex.WSAStartup(MakeWord(2,2), m_WSAData) = 0;
end;

procedure WSACleanup;
begin
  WinSock2Ex.WSACleanup();
end;

function GetHostIPAddr: PAnsiChar;
var
  pHostE: PHostEnt;
  Buffer: array[0..100] of Ansichar;
begin
  Result := '127.0.0.1';
  WinSock2Ex.GetHostName(Buffer, Sizeof(Buffer));
  pHostE := WinSock2Ex.GetHostByName(Buffer);
  if pHostE<> nil then
    Result := WinSock2Ex.inet_ntoa(PInAddr(pHostE^.h_addr_list^)^);
end;

function GetRemoteIPAddr(FRemoteAddr: TSockAddrIn): PAnsiChar;
begin
  Result := WinSock2Ex.inet_ntoa(FRemoteAddr.sin_addr);
end;

function GetRemotePort(FRemoteAddr: TSockAddrIn): WORD;
begin
  Result := FRemoteAddr.sin_port;
end;

function CloseWinSocket(var m_Socket: TSocket): Boolean;
begin
  Result := WinSock2Ex.closesocket(m_Socket) <> SOCKET_ERROR;
  m_Socket := INVALID_SOCKET;
end;

function AbortiveCloseSocket(var m_Socket: TSocket): Boolean;
var
  lingerStrt: TLinger;
begin
  if m_Socket <> INVALID_SOCKET then begin
    Result := FALSE;
    Exit;
  end;

  lingerStrt.l_onoff := 1;
  lingerStrt.l_linger := 0;
  if WinSock2Ex.setsockopt( m_Socket,
                          SOL_SOCKET,
                          SO_LINGER,
                          @lingerStrt,
                          sizeof(lingerStrt) ) = SOCKET_ERROR then begin
    Result := FALSE;
    Exit;
  end;

  Result := CloseWinSocket(m_Socket);
end;

function CreateTCPOverlapSocket(var m_Socket: TSocket): Boolean;
begin
  Result := TRUE;

  m_Socket := WinSock2Ex.WSASocket(AF_INET, SOCK_STREAM, 0, Nil, 0, WSA_FLAG_OVERLAPPED);
  if m_Socket = INVALID_SOCKET then begin
    Result := FALSE;
  end;
end;

function CreateUDPOverlapSocket(var m_Socket: TSocket): Boolean;
begin
  Result := TRUE;

  m_Socket := WinSock2Ex.WSASocket(AF_INET, SOCK_DGRAM, IPPROTO_UDP, Nil, 0, WSA_FLAG_OVERLAPPED);
  if m_Socket = INVALID_SOCKET then begin
    Result := FALSE;
  end;
end;

function CreateWSASocket(var m_Socket: TSocket): Boolean;
begin
  Result := TRUE;

  m_Socket := WinSock2Ex.Socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
  if m_Socket = INVALID_SOCKET then begin
    Result := FALSE;
  end;
end;

function SetUDPSocketSize(var m_Socket: TSocket; BufSize: DWORD): Boolean;
var
  nRet: Integer;
begin
  Result := TRUE;

  nRet := WinSock2Ex.SetSockOpt(m_Socket, SOL_SOCKET, SO_RCVBUF, PAnsiChar(@BufSize), SizeOf(BufSize));
  if nRet = SOCKET_ERROR then begin
    Result := FALSE;
    Exit;
  end;

  nRet := WinSock2Ex.SetSockOpt(m_Socket, SOL_SOCKET, SO_SNDBUF, PAnsiChar(@BufSize), SizeOf(BufSize));
  if nRet = SOCKET_ERROR then Result := FALSE;
end;

function SetSocketReUseAddr(var m_Socket: TSocket): Boolean;
var
  bVal: LongBool;
  nRet: Integer;
begin
  Result := TRUE;
  bVal := True;
  nRet := WinSock2Ex.SetSockOpt(m_Socket, SOL_SOCKET, SO_REUSEADDR, PAnsiChar(@bVal), SizeOf(bVal));
  if (nRet = SOCKET_ERROR) then begin
    Result := FALSE;
  end;
end;

function ChangeSocketModeAccept(var m_Socket, m_sListen: TSocket): Boolean;
begin
  Result := True;

  if (SOCKET_ERROR = WinSock2Ex.setsockopt( m_Socket,
                                 SOL_SOCKET,
                                 SO_UPDATE_ACCEPT_CONTEXT,
                                 PAnsiChar(@m_sListen),
                                 SizeOf(m_sListen) )) then
  begin
    CloseWinSocket(m_Socket);
		Result := FALSE;
  end;
end;

function SetSocketNagle(var m_Socket: TSocket; bVal: Boolean = TRUE): Boolean;
begin
  Result := True;

  (* 禁止nagle算法bVal := TRUE; *)
  if WinSock2Ex.setsockopt( m_Socket,
                          IPPROTO_TCP,
                          TCP_NODELAY,
                          PAnsiChar(@bVal),
                          SizeOf(bVal) ) = SOCKET_ERROR then begin

    CloseWinSocket(m_Socket);
		Result := FALSE;
  end;
end;

function SetKeepAlive(var m_Socket: TSocket; bVal: Boolean; AKeepAliveTime:Cardinal): Boolean;
type
  TCP_KEEPALIVE = record
    OnOff: Cardinal;
    KeepAliveTime: Cardinal;
    KeepAliveInterval: Cardinal
  end;
var
  inKeepAlive, OutKeepAlive: TCP_KEEPALIVE;
  outByte: DWord;
begin
  Result := True;
  if WinSock2Ex.setsockopt(m_Socket, SOL_SOCKET, SO_KEEPALIVE, @bVal, sizeof(bVal)) = SOCKET_ERROR then begin
    CloseWinSocket(m_Socket);
		Result := FALSE;
    exit;
  end;

  inKeepAlive.OnOff := 1;
  inKeepAlive.KeepAliveTime := AKeepAliveTime;
  inKeepAlive.keepaliveinterval := 1;
  if WinSock2Ex.WSAIoctl( m_Socket,
               SIO_KEEPALIVE_VALS,
               @inKeepAlive,
               sizeof(TCP_KEEPALIVE),
               @outKeepAlive,
               sizeof(TCP_KEEPALIVE),
               outByte,
               nil,
               nil ) = SOCKET_ERROR then begin
    CloseWinSocket(m_Socket);
		Result := FALSE;
  end;
end;

function SetRecvTimeOut(var m_Socket: TSocket; m_nTimeOut: Integer):Boolean;
begin
  Result := True;
  if WinSock2Ex.SetSockOpt( m_Socket,
                          SOL_SOCKET,
                          SO_RCVTIMEO,
                          PAnsiChar(@m_nTimeOut),
                          sizeof(m_nTimeOut) )= SOCKET_ERROR then
  begin
    CloseWinSocket(m_Socket);
		Result := FALSE;
  end;
end;

function SetSendTimeOut(var m_Socket: TSocket; m_nTimeOut: Integer):Boolean;
begin
  Result := True;
  if WinSock2Ex.SetSockOpt( m_Socket,
                          SOL_SOCKET,
                          SO_SNDTIMEO,
                          PAnsiChar(@m_nTimeOut),
                          sizeof(m_nTimeOut) )= SOCKET_ERROR then
  begin
    CloseWinSocket(m_Socket);
		Result := FALSE;
  end;
end;

function LoadAcceptEx( var m_Socket: TSocket;
                       var m_lpfnAcceptEx: LPFN_AcceptEx ): Boolean;
var
  dwBytesReceived: DWORD;
begin
  Result := True;

  if ( WinSock2Ex.WSAIoctl( m_Socket,
                 SIO_GET_EXTENSION_FUNCTION_POINTER,
                 @GuidAcceptEx,
                 sizeof(GuidAcceptEx),
                 @@m_lpfnAcceptEx,
                 sizeof(@m_lpfnAcceptEx),
                 dwBytesReceived,
                 nil,
                 nil) = SOCKET_ERROR ) then begin
                 
    Result := FALSE;
  end;
end;

function LoadAcceptExSockaddrs( var m_Socket: TSocket;
                                var m_lpfnGetAcceptExSockaddr: LPFN_GetAcceptExSocketaddr ): Boolean;
var
  dwBytesReceived: DWORD;
begin
  Result := True;

  if ( WinSock2Ex.WSAIoctl( m_Socket,
                 SIO_GET_EXTENSION_FUNCTION_POINTER,
                 @GuidGetAcceptExSockaddrs,
                 sizeof(GuidGetAcceptExSockaddrs),
                 @@m_lpfnGetAcceptExSockaddr,
                 sizeof(@m_lpfnGetAcceptExSockaddr),
                 dwBytesReceived,
                 nil,
                 nil) = SOCKET_ERROR ) then begin

    Result := FALSE;
  end;
end;

function LoadTransmitFile( var m_Socket: TSocket;
                           var m_lpfnTransmitFile: LPFN_TransmitFile ): Boolean;
var
  dwBytesReceived: DWORD;
begin
  Result := True;

  if ( WinSock2Ex.WSAIoctl( m_Socket,
                 SIO_GET_EXTENSION_FUNCTION_POINTER,
                 @GuidTransmitFile,
                 sizeof(GuidTransmitFile),
                 @@m_lpfnTransmitFile,
                 sizeof(@m_lpfnTransmitFile),
                 dwBytesReceived,
                 nil,
                 nil) = SOCKET_ERROR ) then begin

    Result := FALSE;
  end;
end;

function LoadDisconnectEx( var m_Socket: TSocket;
                           var m_lpfnDisconnectEx: LPFN_DisconnectEx ): Boolean;
var
  dwBytesReceived: DWORD;
begin
  Result := True;

  if ( WinSock2Ex.WSAIoctl( m_Socket,
                 SIO_GET_EXTENSION_FUNCTION_POINTER,
                 @GuidDisConnectEx,
                 sizeof(GuidDisConnectEx),
                 @@m_lpfnDisconnectEx,
                 sizeof(@m_lpfnDisconnectEx),
                 dwBytesReceived,
                 nil,
                 nil) = SOCKET_ERROR ) then begin

    Result := FALSE;
  end;
end;

function IsBindSocket(m_nPort: Integer): Boolean;
var
  m_Socket: TSocket;
  sock_Addr: TSockAddrIn;
begin
  Result := True;
  if not CreateTCPOverlapSocket(m_Socket) then begin
    Result := FALSE;
    Exit;
  end;

  FillChar(sock_Addr, SizeOf(sock_Addr), 0);
  sock_Addr.sin_family := AF_INET;
  sock_Addr.sin_addr.S_addr := INADDR_ANY;
  sock_Addr.sin_port := WinSock2Ex.htons(m_nPort);

  if WinSock2Ex.Bind( m_Socket,
           TSockAddr(sock_Addr),
           sizeof(sock_Addr) ) = SOCKET_ERROR then begin
    Result := FALSE;
	end;
  CloseWinSocket(m_Socket);
end;

function BindSocket(var m_Socket: TSocket; m_nPort: Integer): Boolean;
var
  sock_Addr: TSockAddrIn;
begin
  Result := True;

  FillChar(sock_Addr, SizeOf(sock_Addr), 0);
  sock_Addr.sin_family := AF_INET;
  sock_Addr.sin_addr.S_addr := INADDR_ANY;
  sock_Addr.sin_port := WinSock2Ex.htons(m_nPort);

  if WinSock2Ex.Bind( m_Socket,
           TSockAddr(sock_Addr),
           sizeof(sock_Addr) ) = SOCKET_ERROR then begin

    CloseWinSocket(m_Socket);
    Result := FALSE;
	end;
end;

function BindSocket(var m_Socket: TSocket; const strIPAddr: AnsiString; m_nPort: Integer): Boolean;
var
  sock_Addr: TSockAddrIn;
begin
  Result := True;

  FillChar(sock_Addr, SizeOf(sock_Addr), 0);
  sock_Addr.sin_family := AF_INET;
  sock_Addr.sin_addr.S_addr := WinSock2Ex.inet_addr(PAnsiChar(strIPAddr));
  sock_Addr.sin_port := WinSock2Ex.htons(m_nPort);

  if WinSock2Ex.Bind( m_Socket,
           TSockAddr(sock_Addr),
           sizeof(sock_Addr) ) = SOCKET_ERROR then begin

    CloseWinSocket(m_Socket);
    Result := FALSE;
	end;
end;

function ListenSocket(var m_Socket: TSocket): Boolean;
begin
  if WinSock2Ex.Listen(m_Socket, 5) = SOCKET_ERROR then begin

    CloseWinSocket(m_Socket);
    Result := FALSE;
    Exit;
	end;

 Result := True;
end;

function Connect(var m_Socket: TSocket; strIPAddr: AnsiString; nPort: DWORD): Boolean;
var
  nRet: Integer;
  FSockAddr: TSockAddrIn;
begin
  Result := TRUE;
  FillChar(FSockAddr, SizeOf(FSockAddr), 0);
  FSockAddr.sin_family := AF_INET;
  FSockAddr.sin_port := WinSock2Ex.htons(nPort);
  FSockAddr.sin_addr.S_addr := inet_addr(PAnsiChar(strIPAddr));

  nRet := WinSock2Ex.connect(m_Socket, TSockAddr(FSockAddr), SizeOf(FSockAddr));
  if ( (nRet = SOCKET_ERROR) and
       (WinSock2Ex.WSAGetLastError()<>WSAEWOULDBLOCK) ) then begin

    CloseWinSocket(m_Socket);
    Result := FALSE;
  end;
end;

procedure WriteSocketConnRegKey;
var
  reg: TRegistry;
begin
  reg := TRegistry.Create;

  try
    reg.RootKey := HKEY_LOCAL_MACHINE;
    if reg.OpenKey('\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters', FALSE) then begin
      reg.WriteInteger('KeepAliveTime', $000927C0);
      reg.WriteInteger('TcpTimedWaitDelay', $0000001E);
      reg.WriteInteger('MaxUserPort', $0000FFE);
      reg.CloseKey;
    end;
  finally
    reg.Free;
  end;
end;

initialization
  WSAStartup;
  WriteSocketConnRegKey;

finalization
  WSACleanup;


end.
